home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir24 / aprs503a.zip / MAPFIX.BAS < prev    next >
BASIC Source File  |  1994-05-25  |  55KB  |  1,202 lines
  1. REM MAPFIX.bas PROGRAM.  SEE EXPLAINATION BELOW
  2. REM
  3. Ver$ = "4.05"
  4. MaxNumMAPS = 120'was 99 Current maximum number of maps loaded by APRS
  5. MaxNumPoints = 1500 'was 1000
  6. MaxNumLABELS = 99 'was 99
  7. MaxNumLines = 900
  8. REM $DYNAMIC
  9. GOTO BEGIN
  10.  
  11. Info: COLOR 15, 4: CLS
  12.    PRINT " MAPFIX.bas VERSION "; Ver$; " PROGRAM FOR FIXING APRS MAPS": PRINT
  13.    PRINT " This program has evolved significantly.  305 added a TRIM command to eliminate"
  14.    PRINT " all points outside an area.  3.07B adds W7KKE's GPS track history overlays and"
  15.    PRINT " digitizer code for using a drawing tablet.  308 fixed a filename bug.  Now in"
  16.    PRINT " 312, it will take USGS data from the 2,000,000:1 CD ROM and build APRS maps!"
  17.    PRINT " BUT NOT EASILY!  For a 50 mile map, there are 5 MBytes of USGS data which must"
  18.    PRINT " be filtered to get down to the 10K APRS size for the same area! The final steps"
  19.    PRINT " are all manual and take almost as long as developing an APRS map from scratch!"
  20.    PRINT
  21.    PRINT " CAUTION, THIS PROGRAM IS NOT PERFECT... KEEP BACKUPS!  Do a little at a time!"
  22.    PRINT
  23.    PRINT " Although MAPFIX has commands to make map modifications easier, a text EDITOR is"
  24.    PRINT " still useful for whole scale rearranging of points and features in a map file. "
  25.    PRINT
  26.    PRINT " MAPFIX uses two cursors.  The normal yellow APRS cursor, and a White MapPoint"
  27.    PRINT " which will be the next point to be processed.  ALT Keys allow you to MOVE the"
  28.    PRINT " MapPoint to the cursor, ADD a new point at the cursor, or DELETE the MapPoint."
  29.    PRINT " MAPFIX.bas shows you Deg/Min, Decimal, and APRS values of the cursor position."
  30.    PRINT
  31.    PRINT " ALSO NOTE THAT THE LIMITS IN APRS ARE 1000 POINTS, 99 FEATURES, and 99 LABELS!"
  32.    PRINT " If you need more points, features or labels, begin another map.";
  33.    LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
  34.    GOSUB GetChar: SOUND 800, 3
  35.   
  36. Info2:   COLOR 15, 8: CLS
  37.    PRINT " PAGE 2 INSTRUCTIONS:  More about new features in version "; Ver$
  38.    PRINT
  39.    PRINT " With this new MAPFIX.bas, you can not only modify features by moving, adding"
  40.    PRINT " or deleting POINTS, but you can now add and kill FEATURES too, ie: roads,"
  41.    PRINT " rivers, borders, etc, from within the program.  In addition to the new KILL"
  42.    PRINT " and TRIM commands, the G key will move the cursor (GOTO) to the MapPoint,"
  43.    PRINT " and the F key will FIND the MapPoint nearest the cursor location.  If the"
  44.    PRINT " MapPointer and FeatureName get out of sequence, the RESET command may fix"
  45.    PRINT " them, but you should save the file immediately and check it with an editor."
  46.    PRINT
  47.    PRINT " I find the capability to delete points very useful when making larger area"
  48.    PRINT " maps from several smaller detail maps.  First, I run MAPCNVRT.bas to convert"
  49.    PRINT " all of the smaller maps to new temporary files with the new origin of the new"
  50.    PRINT " larger map.  Then I use the KILL command in MAPFIX to eliminate all minor "
  51.    PRINT " roads, features and labels and then the DELETE POINT command to remove all"
  52.    PRINT " inconsequential minor points from the roads that will not be needed"
  53.    PRINT " at the larger scale.  Then I use the editor to combine all of the points and"
  54.    PRINT " labels into the new file."
  55.    PRINT
  56.    PRINT " A new MAPLIST command shows your MAPLIST.map file; and the OTHER MAPS command"
  57.    PRINT " shows all MAP borders so you can see how your new map fits in.  You may use F3"
  58.    PRINT " and F4 keys to select smaller or larger map borders to draw."
  59.    PRINT
  60.    LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
  61.    GOSUB GetChar: SOUND 800, 3
  62.   
  63. Info3:   COLOR 15, 3: CLS
  64.    PRINT " PAGE 3 INSTRUCTIONS:  Using GPS Track History Files to draw maps!"
  65.    PRINT
  66.    PRINT " To aid in creating accurate maps, W7KKE in California added routines to MAPFIX"
  67.    PRINT " so that you can overlay a Track History file onto the map you are constructing."
  68.    PRINT " This is an excellent tool for correcting your maps to real GPS data."
  69.    PRINT ""
  70.    PRINT " After you have loaded your map, type alt-G (GPS Track History') and enter the"
  71.    PRINT " history filename.  This will overlay the track history file.  You may then"
  72.    PRINT " use the normal MAPFIX.bas routines to move map segments and add so that the"
  73.    PRINT " map will agree with the GPS data contained in the track history file.  This"
  74.    PRINT " is especially useful with the history files saved by a laptop during mobile"
  75.    PRINT " GPS operations."
  76.    PRINT
  77.    PRINT " CAUTION:  Since GPS data is only accurate to 100 yards due to the effects of"
  78.    PRINT " Selective Availability, I would avoid using GPS data explicitely below about"
  79.    PRINT " the 2 mile range.  For this reason, I make the size of the GPS positions "
  80.    PRINT " expand below the 2 mile range to roughly approximate the size of the 100 yard"
  81.    PRINT " error circle."
  82.    PRINT
  83.    PRINT " Also note that you can now START a NEW map from scratch, without using the"
  84.    PRINT " text editor to enter the initial configuration data.  Just type NEW instread "
  85.    PRINT " of a MAPfilename when starting up the program."
  86.    LOCATE 25, 1: PRINT " HIT ANY KEY to continue...";
  87.    GOSUB GetChar: SOUND 800, 3
  88.  
  89.  
  90. Info4:   COLOR 15, 7: CLS
  91.    PRINT " PAGE 4 INSTRUCTIONS FOR USING A DIGITIZER:": PRINT
  92.    PRINT " In version 3.07B, MAPFIX.bas can now interface to a digitizer tablet or table"
  93.    PRINT " so that maps can be drawn directly from paper maps.  These routines were"
  94.    PRINT " developed by W7KKE and added to MAPFIX.bas in December 1993."
  95.    PRINT
  96.    PRINT " To use a digitizer, first you must hit the ALT-O command to open the COMM"
  97.    PRINT " PORT for the digitizer.  This command also lets you test the digitizer while"
  98.    PRINT " testing the alignment of the map on the digitizer surface.  It then prompts"
  99.    PRINT " you to identify the upper left and lower right corners of the map, in order"
  100.    PRINT " to calibrate the digitizer to the latitude, longitude and scale of the map."
  101.    PRINT
  102.    PRINT " From this point on, the button on the digitizer mouse is almost identical to"
  103.    PRINT " the ALT-A command for ADDing a point.  To start a new map feature, however,"
  104.    PRINT " for the digitizer, you DO NOT use the ALT-N NEW command, but you should use"
  105.    PRINT " the ALT-B BEGIN command.  For More information, see the README.DIG file."
  106.    PRINT
  107.    PRINT " To speed up the map drawing during editing, I no longer erase and re-draw"
  108.    PRINT " the entire map with each new point.  I simply draw just the new line segment."
  109.    PRINT " Sometimes, especially when you move, or add a line, this leaves an old line"
  110.    PRINT " segment, where there actually is no longer a line.  You can always celan up"
  111.    PRINT " the map by just hitting the space bar to force a new map..."
  112.    PRINT
  113.  
  114.   
  115.    Display$ = "UNKnown"
  116.    RETURN
  117.  
  118. GetChar: a$ = "": DO UNTIL a$ <> "": a$ = INKEY$: LOOP: RETURN
  119.  
  120. BEGIN: GOSUB Info:
  121.    PRINT " HIT ANY KEY to proceed onto the HELP screen...";
  122.    GOSUB GetChar
  123.  
  124.    DIM x%(5 * MaxNumPoints), y%(5 * MaxNumPoints)
  125.    REM MAP coordinates               **** THESE ARE BIGGER THAN APRS ***
  126.    DIM LN$(MaxNumLines) ' (no limit in APRS)  **** SO YOU CAN MANIPULATE BIG MAPS
  127.    nn = 2 * MaxNumLABELS
  128.    DIM ML$(nn), MLa(nn), MLo(nn), MLr(nn) 'Map Labels, lengths and coordinates
  129.    nn = 2 * MaxNumMAPS
  130.    DIM MapName$(nn), LATcen(nn), LONcen(nn), MapMax(nn), Comment$(nn)
  131.    RdsOn = -1: Labls = -1: Tags = -1: KP = 1: Changed = 0: MapSize = 256
  132.    i = 1000
  133.    DIM HLAT(i), HLONG(i)'For lat/longs from big GPS history files
  134.  
  135. INIT: ON ERROR GOTO ErrorTrap
  136.    ScrnType$ = "EGA": Ycen = 200: Yfactr = 1: YfacTXT = 350 / 350: SCREEN 9
  137.    IF ScrnType$ = "EGA" THEN COLOR 15, 0
  138.    REM ScrnType$ = "CGA": Yfactr=200/400:Ycen = 200*Yfactr: SCREEN 2
  139.    ReDraw = -1
  140.   
  141. Display$ = "HELP": GOSUB HELP: GOSUB LoadMap
  142. REM ON ERROR GOTO 0
  143.  
  144. Main: GOSUB DrwMPaCur
  145.   DO
  146. GoAgain: Fault = 0
  147.     IF Digitizer THEN
  148.          IF LOC(1) > 9 THEN
  149.             GOSUB GetXY: GOSUB Cursor
  150.             IF Btn <> 3 THEN GOSUB AddPoint
  151.          END IF
  152.     END IF
  153.     a$ = INKEY$
  154.     IF a$ <> "" THEN
  155.         a$ = UCASE$(a$): Key$ = a$
  156.         IF a$ = "S" THEN GOSUB labels
  157.         IF a$ = "L" THEN Labls = NOT Labls
  158.         IF a$ = "T" THEN Tags = NOT Tags
  159.         IF a$ = "F" THEN LnStrt = 0: StrtSrch = 1: GOSUB FindPoint
  160.         IF a$ = CHR$(6) THEN LnStrt = LnPtr: StrtSrch = Z + 1: GOSUB FindPoint
  161.         IF a$ = "G" THEN GOSUB CurToPoint: GOSUB CurDrwMap
  162.         IF a$ = "H" THEN
  163.            IF Display$ <> "HELP" THEN
  164.               GOSUB HELP
  165.            ELSE GOSUB Info
  166.               LOCATE 25, 1: PRINT " H for HELP or SPACE BAR for map..."; : a$ = ""
  167.            END IF
  168.         END IF
  169.         IF a$ = "B" THEN GOSUB BoxPPD
  170.         IF a$ = "U" THEN GOSUB GetUSGS
  171.         IF a$ = "D" THEN GOSUB MapDIR
  172.         IF a$ = "M" THEN GOSUB ListMAPlist
  173.         IF a$ = "O" THEN GOSUB DrwAndShow
  174.         IF a$ = "N" THEN GOSUB NextLine: GOSUB Cursor
  175.         IF a$ = "P" THEN GOSUB Previous: GOSUB Cursor
  176.         IF a$ = "Q" THEN GOSUB QUIT
  177.         IF a$ = "R" THEN Z = 2: LnPtr = 1
  178.         IF a$ = "T" THEN GOSUB Scrunch
  179.         IF a$ = " " THEN Display$ = "MAP": ReDraw = -1: USGS = 0: GOSUB DrwMPaCur
  180.         IF a$ = "+" THEN Z = Z + 1: GOSUB MapPoint ' moves to next map point
  181.         IF a$ = "-" THEN Z = Z - 1: GOSUB MapPoint ' moves backwards
  182.         IF a$ = CHR$(18) THEN ReDraw = NOT ReDraw: GOSUB ReDraw
  183.        
  184.         B$ = "": IF LEN(a$) = 2 THEN B$ = RIGHT$(a$, 1): REM process arrow & special keys
  185.         IF B$ = "I" THEN RS = RS * 2: GOSUB CurDrwMap: REM change scale
  186.         IF B$ = "Q" THEN RS = RS / 2: GOSUB CurDrwMap
  187.         IF B$ = CHR$(132) THEN RS = RS * 8: GOSUB CurDrwMap: REM change scale by factor of 4
  188.         IF B$ = "V" THEN RS = RS / 8: GOSUB CurDrwMap
  189.         IF B$ = "G" THEN GOSUB CurDrwMap 'Home key
  190.         IF a$ = "7" THEN CDX = LONo: CDY = LATo: GOSUB DrwMPaCur 'ShiftHOME
  191.         IF B$ = "O" THEN CDX = LONcen: CDY = LATcen: GOSUB DrwMPaCur 'End Key
  192.         IF B$ = "M" THEN CPX = CPX - 4 / (Sfac): GOSUB Cursor
  193.         IF B$ = "K" THEN CPX = CPX + 4 / (Sfac): GOSUB Cursor
  194.         IF B$ = "H" THEN CPY = CPY + 4 / (Sfac): GOSUB Cursor
  195.         IF B$ = "P" THEN CPY = CPY - 4 / (Sfac): GOSUB Cursor
  196.         REM Here are the special MapFIx routines
  197.         IF B$ = CHR$(30) THEN GOSUB AddPoint               'alt-ADD point
  198.         IF B$ = CHR$(48) AND Digitizer THEN GOSUB NewFeature'alt-BEGIN
  199.         IF B$ = CHR$(34) THEN GOSUB LoadHst                'alt-GPS hstry file
  200.         IF B$ = CHR$(50) THEN GOSUB MakePT: IF ReDraw THEN GOSUB DrawMap 'MOVE point to cursor
  201.         IF B$ = CHR$(32) THEN GOSUB DelPT                  'alt-DELete point
  202.         IF B$ = CHR$(38) THEN GOSUB AddLabel               'alt-ADD LABEL
  203.         IF B$ = CHR$(46) THEN GOSUB NewCenter              'alt-CENTER
  204.         IF B$ = CHR$(36) THEN GOSUB Join                   'alt-JOIN
  205.         IF B$ = CHR$(37) THEN GOSUB KillF                  'alt-KILL Feature
  206.         IF B$ = CHR$(19) THEN GOSUB MapRange               'alt-RANGE
  207.         IF B$ = CHR$(20) THEN GOSUB TRIM                   'alt-TRIM
  208.         IF B$ = CHR$(49) THEN GOSUB NewFeature             'alt-NEW Feature
  209.         IF B$ = CHR$(24) THEN GOSUB DigiInit: GOSUB DrawMap'alt-OPEN dgtzr COM
  210.         IF B$ = CHR$(31) THEN GOSUB Scrunch                'alt-SCRUNCH
  211.         IF B$ = CHR$(22) THEN GOSUB GetUSGS                'alt-U
  212.         IF B$ = CHR$(61) THEN                              'F3 for smaller Maps
  213.            MapSize = MapSize / 2: IF MapSize < 1 THEN MapSize = 1
  214.            GOSUB ShowMaps
  215.            END IF
  216.         IF B$ = CHR$(62) THEN                              'F4 for larger Maps
  217.            MapSize = MapSize * 2: IF MapSize > 1000 THEN MapSize = 1000
  218.            GOSUB DrwAndShow
  219.         END IF
  220.         IF a$ = CHR$(19) THEN GOSUB SaveMap
  221.         IF a$ = CHR$(3) THEN GOSUB ChgColr
  222.            
  223.         IF a$ = "6" THEN CPX = CPX - 20 / (Sfac): GOSUB Cursor'SHIFT Cursor by 4
  224.         IF a$ = "4" THEN CPX = CPX + 20 / (Sfac): GOSUB Cursor
  225.         IF a$ = "8" THEN CPY = CPY + 20 / (Sfac): GOSUB Cursor
  226.         IF a$ = "2" THEN CPY = CPY - 20 / (Sfac): GOSUB Cursor
  227.         
  228.     END IF
  229.   LOOP
  230.   SYSTEM 'you should never get here
  231.  
  232. ReDraw: LOCATE 1, 30
  233.         IF ReDraw THEN PRINT "REDRAW ENABLED":  ELSE PRINT "NO ReDraw...  "
  234.         RETURN
  235.  
  236. QUIT: a$ = "Y"
  237.       IF Changed THEN
  238.          GOSUB BoxLine23
  239.          PRINT "**** MAP HAS BEEN MODIFIED"; Changed; "TIMES BUT NOT SAVED!!!  SAVE NOW? (Y)";
  240.          INPUT a$
  241.       IF UCASE$(a$) <> "N" THEN GOSUB SaveMap
  242.       END IF
  243.       SYSTEM
  244.  
  245. TRIM: GOSUB BoxLine23
  246.       CLS : PRINT "TRIM ALL POINTS AND LABELS OUTSIDE OF MAPRANGE"
  247.       PRINT
  248.       PRINT "This command will remove all points and labels that are outside of the white"
  249.       PRINT "map border.  You can change the location of this map border by using"
  250.       PRINT "the CENTER command (alt-C) and by changing the RANGE using alt-R."
  251.       PRINT : PRINT
  252.       PRINT "No map feature will be completely eliminated..."
  253.       PRINT
  254.       PRINT "The first and last point of any FEATURE will be retained, so the"
  255.       PRINT "result will be long single lines for all FEATURES outside the map border."
  256.       PRINT "Use the KILL FEATURE (alt-K) to eliminate those lines and use the MOVE"
  257.       PRINT "command (alt-M) to move any far away points closer to the border."
  258.       PRINT : PRINT
  259.       PRINT "You might consider stopping now and doing a SAVE (ctrl-S) before proceeding."
  260.       PRINT
  261.       PRINT "ALSO, THIS DOES NOT WORK FOR POINTS WITH NEGATIVE VALUES!  Be sure  your"
  262.       PRINT "selected area is below and to right of ORIGIN.  If not, run MAPCNVRT.bas."
  263.       PRINT : PRINT
  264.       INPUT "Are you ready to proceed? (Y/N) (N)"; ans$
  265.       GOSUB DrawMap
  266.       IF UCASE$(ans$) <> "Y" THEN RETURN
  267.       C = 0: LOCATE 23, 1: PRINT "Processing...";
  268.       REM dx and dy are num pix of center of map
  269.       REM bx and by are borders of map based on MapRng
  270.       by = ppdV * MapRng / 60
  271.       bx = by / Lfac
  272.       FOR Z = 1 TO nmp - 4
  273.          IF x%(Z) = 0 THEN Z = Z + 2
  274.          IF x%(Z) > dx + bx OR y%(Z) > dy + by THEN bad = 1 ELSE bad = 0
  275.          IF x%(Z) < dx - bx OR y%(Z) < dy - by THEN bad = 1
  276.          IF bad AND x%(Z - 1) <> 0 AND x%(Z + 1) <> 0 THEN
  277.             GOSUB DelPT: Z = Z - 1
  278.             C = C + 1
  279.          END IF
  280.       NEXT Z
  281.       LOCATE 23, 1: PRINT "Now removing labels...";
  282.       FOR i = 1 TO nml: REM now eliminate all labels outside
  283.           bad = 0: Xm = MapRng / (60 * Lfac): Ym = MapRng / 60
  284.           IF MLo(i) > LONcen + Xm OR MLa(i) > LATcen + Ym THEN bad = 1
  285.           IF MLo(i) < LONcen - Xm OR MLa(i) < LATcen - Ym THEN bad = 1
  286.           IF bad = 1 THEN
  287.              FOR j = i TO nml
  288.                  ML$(j) = ML$(j + 1): MLa(j) = MLa(j + 1)
  289.                  MLo(j) = MLo(j + 1): MLr(j) = MLr(j + 1)
  290.              NEXT j: nml = nml - 1: PRINT ".";
  291.           END IF
  292.       NEXT i
  293.       GOTO DrawMap
  294.  
  295.  
  296. FindPoint: CurX = INT(.5 + dx + (CUX - 320) / KP)
  297.            CurY = INT(.5 + dy + (CUY - Ycen) / KP)
  298.  
  299.      GOSUB BoxLine23: PRINT "SEARCHING THROUGH ALL POINTS IN FILE...";
  300.      REM SaveZ = Z: SaveLNptr = LnPtr
  301. Agn: FOR j = 0 TO 30            ' Go through abt 20 times lookin pt.
  302.         IF j > 10 THEN j = j + 1' first with 0 delta, then bigger
  303.         PRINT ".";
  304.         LnCtr = LnStrt
  305.         FOR i = StrtSrch TO nmp
  306.             IF x%(i) = 0 THEN LnCtr = LnCtr + 1
  307.             IF x%(i) > CurX - j AND x%(i) < CurX + j THEN
  308.                IF y%(i) > CurY - j AND y%(i) < CurY + j THEN
  309.                   Z = i: LnPtr = LnCtr: GOSUB CurToPoint
  310.                   j = 99: i = nmp
  311.                END IF
  312.             END IF
  313.         NEXT i:
  314.     NEXT j
  315.     IF j < 99 AND Key$ = CHR$(6) THEN StrtSrch = 2: LnCtr = 1: Key$ = "F": GOTO Agn
  316.     IF j < 99 THEN PRINT "None found!": RETURN
  317.     GOSUB MapPoint: SavClr = 0: RETURN
  318.                   
  319. NewFeature: LOCATE 24, 1: PRINT SPACE$(27); : GOSUB BoxLine23
  320.             INPUT "Enter reference name for new feature"; a$
  321.             IF a$ = "" THEN RETURN
  322.             GOSUB Rainbow: IF abort THEN RETURN
  323.             GOSUB BeginF
  324.             GOSUB BoxLine23: LOCATE 25, 1: PRINT SPACE$(80); : LOCATE 25, 1
  325.             IF RIGHT$(Key$, 1) = CHR$(48) THEN
  326.                PRINT "NOW USE DIGITIZER TO ADD NEW POINTS TO THIS FEATURE...";
  327.                GOSUB GetXY: GOSUB Cursor
  328.             ELSE
  329.                PRINT "NOW MOVE CURSOR AND USE ALT-A TO ADD POINTS TO THIS NEW FEATURE...";
  330.             END IF
  331.             GOSUB MakePT
  332.             RETURN
  333.  
  334. Rainbow: LOCATE 25, 1
  335.          FOR i = 0 TO 14
  336.              PRINT RIGHT$(" " + MID$(STR$(i + 1), 2), 2); "   ";
  337.              LINE (16 + i * 40, 335 * YfacTXT)-(40 + i * 40, 349 * YfacTXT), i + 1, BF
  338.          NEXT i
  339.          GOSUB BoxLine23
  340.          INPUT "Select color (4,7,10-Hwys 11-Water 12-Hwy 13-Spcl 14-City)"; B$
  341.          SavClr = VAL(B$): IF SavClr > 15 OR SavClr < 1 THEN abort = -1 ELSE abort = 0
  342.          RETURN
  343.  
  344.            
  345. BeginF: x%(nmp) = 0: y%(nmp) = SavClr   'Store feature color 0,c
  346.         LN$(LNi + 1) = LN$(LNi): LnPtr = LNi'Bump up present LN$ comment
  347.         LN$(LNi) = a$: LNi = LNi + 1'Store feature name
  348.         nmp = nmp + 1: Z = nmp
  349.         nmp = nmp + 1: x%(nmp) = 0: y%(nmp) = 0'nmp points to ending 0,0
  350.         RETURN
  351.  
  352. CanclF: nmp = nmp - 2: Z = Kz
  353.         LNi = LNi - 1: LN$(LNi) = LN$(LNi + 1): RETURN
  354.  
  355. NewCenter: LATcen = CPY: LONcen = CPX: Changed = Changed + 1: GOTO CurDrwMap
  356.  
  357. MapRange: GOSUB BoxLine23: INPUT "Enter map range"; a$
  358.           IF VAL(a$) <> 0 THEN MapRng = VAL(a$)
  359.           Changed = Changed + 1: GOTO DrwMPaCur
  360.  
  361. AddPoint: nmp = nmp + 1: Z = Z + 1
  362.           FOR i = nmp TO Z STEP -1
  363.               x%(i) = x%(i - 1): y%(i) = y%(i - 1)
  364.           NEXT
  365.           GOSUB MakePT
  366.           IF SavClr = 0 AND ReDraw THEN GOTO DrawMap
  367.           s = Z - 1: LineColor = SavClr: GOTO DP
  368.  
  369. MakePT: x%(Z) = dx + (CUX - 320) / (KP * Hfac)
  370.         y%(Z) = dy + (CUY - Ycen) / KP
  371.         Changed = Changed + 1
  372.         GOTO MapPoint
  373.  
  374. CurToPoint:
  375.      CPX = CDX - (x%(Z) - dx) / ppdV
  376.      CPY = CDY - (y%(Z) - dy) / (ppdV * Yfactr)
  377.      GOTO Cursor
  378.  
  379. DelPT: GOSUB DelZ
  380.        REM if 1st pt, it stays as 1st pt
  381.  
  382.        IF x%(Z) = 0 THEN Z = Z - 1: REM if end pt, it stays as end
  383.        IF x%(Z + 1) = 0 AND x%(Z - 1) = 0 THEN 'It is LAST point
  384.           GOSUB Kline: LnPtr = LnPtr - 1       'So Kill Line
  385.           GOSUB DelZ                           'And Kiil it
  386.           Z = Z - 1: GOSUB DelZ: Z = Z - 1     'Kill 0,color
  387.        END IF                                  'and -1 to end point
  388.        IF B$ = CHR$(32) AND ReDraw THEN GOSUB DrawMap ELSE GOSUB MapPoint
  389.        RETURN
  390.  
  391. DelZ: nmp = nmp - 1
  392.       FOR i = Z TO nmp
  393.           x%(i) = x%(i + 1): y%(i) = y%(i + 1)
  394.       NEXT: Changed = Changed + 1: RETURN
  395.  
  396. NextLine: IF Z >= nmp - 1 THEN Z = nmp - 1: BEEP: RETURN
  397.           DO UNTIL x%(Z) = 0: Z = Z + 1: LOOP
  398.           IF Z < nmp - 1 THEN Z = Z + 1: LnPtr = LnPtr + 1
  399.           SavClr = 0: GOTO MapPoint
  400. Previous: DO UNTIL Z = 1 OR x%(Z) = 0: Z = Z - 1: LOOP
  401.           IF Z > 3 THEN Z = Z - 1: LnPtr = LnPtr - 1
  402.           SavClr = 0: GOTO MapPoint
  403.  
  404. KillF: GOSUB Find1st: REM Stop at Beginning (0) point of the feature to kill
  405.        ni = Bi + 1' Now scan for next feature
  406.        DO UNTIL x%(ni) = 0: ni = ni + 1: LOOP
  407.        REM now move down rest of array to fill
  408.        DO UNTIL ni = nmp + 1
  409.            x%(Bi) = x%(ni): y%(Bi) = y%(ni)
  410.            Bi = Bi + 1: ni = ni + 1
  411.        LOOP
  412.        nmp = nmp - (ni - Bi): y%(nmp) = 0
  413.        GOSUB Kline
  414.        GOTO DrawMap
  415.     
  416. Find1st: Bi = Z: Changed = Changed + 1
  417.          DO UNTIL x%(Bi) = 0: Bi = Bi - 1: LOOP: Z = Bi + 1
  418.          RETURN
  419.  
  420. ChgColr: GOSUB Find1st: GOSUB Rainbow: IF abort THEN RETURN
  421.          y%(Bi) = SavClr: RETURN
  422.  
  423.  
  424. Kline: FOR i = LnPtr TO LNi
  425.            LN$(i) = LN$(i + 1)
  426.            NEXT i
  427.            LNi = LNi - 1
  428.            RETURN
  429.  
  430. MapPoint:
  431.      IF Z < 2 THEN Z = 2: LnPtr = 1: BEEP: SavClr = 0
  432.      IF Z > nmp - 1 THEN Z = Z - 1: BEEP: SavClr = 0
  433.      IF x%(Z) = 0 THEN
  434.         IF a$ = "-" THEN
  435.              LnPtr = LnPtr - 1: Z = Z - 1
  436.         ELSE LnPtr = LnPtr + 1: Z = Z + 1
  437.         END IF: SavClr = 0
  438.      END IF
  439.      IF LnPtr < 0 THEN LnPtr = 0
  440.      IF Display$ = "MAP" THEN
  441.           LOCATE 22, 1
  442.           PRINT "Fture#"; LnPtr; TAB(12); LEFT$(LN$(LnPtr) + "            ", 12);
  443.      END IF
  444. DrwMpPt: IF Display$ <> "MAP" THEN RETURN
  445.      CIRCLE (Xtest, Ytest), 10, 0 'Erase old circle
  446.      Xtest = 320 + KP * (x%(Z) - dx) * Hfac
  447.      Ytest = Ycen + KP * (y%(Z) - dy) * Yfactr
  448.      CIRCLE (Xtest, Ytest), 10, 15
  449.      
  450.      LOCATE 23, 1: PRINT "MapPt#"; Z;
  451.      IF Z > 999 THEN PRINT TAB(13); "val:";  ELSE PRINT TAB(12); "vals:";
  452.      PRINT TAB(17); x%(Z); TAB(23); y%(Z)
  453.      RETURN
  454.  
  455. AddLabel: nml = nml + 1
  456.           MLa(nml) = CPY: MLo(nml) = CPX
  457.           GOSUB BoxLine23: INPUT "Enter Label Name"; a$: ML$(nml) = a$
  458.           GOSUB BoxLine23: INPUT "Begin displaying label at what range?"; a$
  459.           a = VAL(a$): IF a <> 0 THEN MLr(nml) = a:  ELSE MLr(nml) = 2048
  460.           Changed = Changed + 1: GOTO labels
  461.  
  462. BoxLine23: LOCATE 23, 1: PRINT SPACE$(80); : LOCATE 23, 1: RETURN
  463.  
  464. ErrorTrap: Fault = ERR: 'Error handling routine
  465.            IF ERR = 57 THEN PRINT "  I/O-error-User-logoff"; : RESUME
  466.            IF ERR = 69 THEN PRINT "  Comm-buffer-overflow"; : RESUME
  467.            IF ERR = 53 THEN PRINT "  file-"; F$; "-not-found": CLOSE : RESUME NEXT
  468.            IF ERR = 62 THEN RESUME NEXT
  469.            IF ERR = 52 THEN RESUME NEXT
  470.            IF ERR = 55 THEN RESUME NEXT
  471.            IF ERR = 2 THEN PRINT "SYNTAX-error"
  472.            IF ERR = 70 THEN PRINT " WRITE PROTECTED!...": RESUME NEXT
  473.            IF ERR = 76 THEN PRINT "Wrong Path!": RESUME NEXT
  474.            RESET
  475.            PRINT : PRINT "Error beyond repair. Number = "; ERR;
  476.            INPUT "Hit RETURN to return to DOS"; a$
  477.            SYSTEM
  478.  
  479. MapDIR: CLS : PRINT "MAP FILES DIRECTORY": PRINT
  480.          PRINT "To display MAP files, please enter the path to your xxxxxxx.MAP files."
  481.          PRINT "For example, the default '\APRS\MAPS\*.MAP' will show all maps in the APRS"
  482.          PRINT "directory.  Similarly '*.map' will search your present QB directory."
  483.          PRINT "For any other path, enter the full file specification.": PRINT
  484.          F$ = "\aprs\MAPS\*.map"
  485.          PRINT "Enter Filespec for searching the DIRECTORY ("; F$; ")";
  486.          INPUT a$: IF a$ <> "" THEN F$ = a$
  487.          PRINT : PRINT : FILES F$
  488.          RETURN
  489.  
  490.  
  491. LoadMap: 'Maps are drawn to the default EGA resolution of 640 x 400 (350)
  492. Again: GOSUB BoxLine23
  493.        INPUT " Enter map FILENAME, or NEW, or ? for a list, or Q to quit)"; a$
  494.        a$ = UCASE$(a$): IF a$ = "" THEN GOTO Again
  495.        IF a$ = "Q" THEN SYSTEM
  496.        IF a$ = "?" THEN GOSUB MapDIR: GOTO Again
  497.        IF a$ = "NEW" THEN Key$ = "NEW": GOSUB NewMap: RETURN
  498.        a = INSTR(3, a$, "."): IF a = 0 THEN a$ = a$ + ".MAP"
  499.        MapFile$ = a$: F$ = MapFile$: OPEN F$ FOR INPUT AS #3
  500.        IF Fault = 53 THEN Fault = 0: PRINT : CLOSE #3: GOTO Again
  501.        GOSUB BoxLine23: PRINT " Loading "; F$; "..."
  502.        INPUT #3, LATo: LINE INPUT #3, LATtext$
  503.        INPUT #3, LONo: LINE INPUT #3, LONtext$
  504.        INPUT #3, ppdV: LINE INPUT #3, VS$'Pixels per degree horiz
  505.        INPUT #3, LATcen: LINE INPUT #3, LATcen$
  506.        INPUT #3, LONcen: LINE INPUT #3, LONcen$
  507.        INPUT #3, MapRng: LINE INPUT #3, MapRng$
  508.        INPUT #3, MinRng: LINE INPUT #3, MR$
  509.        LINE INPUT #3, TextLine$ ' Line of comments or instrutcitons
  510.        IF LEFT$(TextLine$, 14) = "Map generated " THEN ReDraw = 0
  511.        RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
  512.        i = 0: LNi = 0:
  513.      
  514.      DO WHILE NOT EOF(3)
  515.         i = i + 1: INPUT #3, x%(i), y: y%(i) = y * Yfactr
  516.         IF x%(i) = 0 AND NOT EOF(3) THEN ' Get line color & store with x=0
  517.            INPUT #3, y%(i): LNi = LNi + 1: LINE INPUT #3, LN$(LNi)' Save line name
  518.            IF y = -1 THEN GOSUB LoadLabels ' All labels listed at end of file
  519.            END IF
  520.         LOOP: nmp = i  'nmp points to 0,-1 that ends all data (but the value
  521.                        'of X% and y% are 0,0 until file is saved.
  522.      LET CDY = LATcen: CDX = LONcen'Center display on ORIGIN
  523.      LET CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
  524.      LET Z = 2: LnPtr = 1: REM start at first point and first line segment
  525.      CLOSE #3: RETURN:     REM first X% value is map color.  2nd val is 1st pt
  526.  
  527.  
  528.  
  529. LoadLabels: k = 0
  530.      DO WHILE NOT EOF(3)
  531.         k = k + 1: INPUT #3, ML$(k), MLa(k), MLo(k), MLr(k)
  532.      LOOP
  533.      IF MLa(k) = 0 OR MLo(k) = 0 THEN nml = k - 1 ELSE nml = k
  534.      RETURN
  535.        
  536. SaveMap: GOSUB BoxLine23
  537.    PRINT "Enter file name to save if other than "; MapFile$;
  538.    INPUT a$: IF a$ <> "" THEN MapFile$ = a$
  539.    F$ = MapFile$
  540.    GOSUB BoxLine23: PRINT "Saving map to file named "; F$; " ..."
  541.    OPEN F$ FOR OUTPUT AS #4
  542.    IF Fault = 70 THEN CLOSE #4: GOTO SaveMap
  543.    PRINT #4, LATo; ","; LATtext$
  544.    PRINT #4, LONo; ","; LONtext$
  545.    PRINT #4, ppdV; ","; VS$
  546.    PRINT #4, LATcen; ","; LATcen$
  547.    PRINT #4, LONcen; ","; LONcen$
  548.    PRINT #4, MapRng; ","; MapRng$
  549.    PRINT #4, MinRng; ","; MR$
  550.    PRINT #4, TextLine$
  551.    j = 1
  552.    FOR i = 1 TO nmp
  553.        IF x%(i) <> 0 THEN WRITE #4, x%(i), INT((y%(i) / Yfactr) + .5)
  554.        IF x%(i) = 0 AND i = nmp THEN PRINT #4, " 0,-1"
  555.        IF x%(i) = 0 AND i <> nmp THEN
  556.           PRINT #4, "0,0"
  557.           PRINT #4, y%(i); ","; LN$(j): j = j + 1
  558.        END IF
  559.    NEXT i
  560.    PRINT #4, "0,"; LN$(LNi)
  561.    FOR k = 1 TO nml
  562.        PRINT #4, ML$(k); ","; : WRITE #4, MLa(k), MLo(k), MLr(k)
  563.    NEXT k: CLOSE #4: LOCATE 24, 1:
  564.    Changed = 0
  565.    IF nmp > MaxNumPoints OR nml > MaxNumLABELS THEN
  566.       CLS : LOCATE 9, 29: PRINT "CAUTION!": PRINT : PRINT
  567.       IF nmp > MaxNumPoints THEN
  568.          PRINT "            The number of points,"; nmp; "is greater than"; MaxNumPoints
  569.       END IF
  570.       IF nml > MaxNumLABELS THEN
  571.          PRINT "            The number of LABELS,"; nml; "is greater than"; MaxNumLABELS
  572.       END IF
  573.       LOCATE 18, 12
  574.       PRINT " Therefore this map will not work with APRS (yet) "
  575.       LOCATE 23, 1: INPUT "HIT Enter to continue..."; a$
  576.    END IF: GOTO DrwMPaCur
  577.  
  578. CurDrwMap: CDX = CPX: CDY = CPY: GOTO DrawMap: REM Re-center at CURSOR location
  579.  
  580. DrwMPaCur: CPX = CDX: CPY = CDY: GOSUB DrawMap
  581.            REM After drawing map, Put cursor at center
  582.            RETURN
  583.  
  584. DrawMap: IF USGS THEN RETURN
  585.     Display$ = "MAP": COLOR 15, 0
  586.    'Draw to range scale RS and center display CDX and CDY
  587.    'Original Map was 40 pix-per-deg Horiz and 20 vert for 200 display
  588.    'Now ppdH and ppdV are variables.  The scaling factor KP is 1 for
  589.    'the original map scale.
  590.    DO WHILE RS < 320 / ppdV: RS = RS * 2: LOOP
  591.    IF RS > 8192 THEN RS = 8192
  592.    KP = 100 * 100 / (RS * ppdV)'This is to scale it down from the 120 maps
  593.    Sfac = 50 * 200 / RS        'Till 307 had been 100*120
  594.  
  595.    Lfac = COS(CDY / 57.296)
  596.    Hfac = (640 / 350) * (3 / 4) * Lfac
  597.    dx = ppdV * (LONo - CDX)
  598.    dy = ppdV * (LATo - CDY)
  599.         
  600.    CLS : LOCATE 1, 2: PRINT "Redrawing Map"
  601.    REM first put ORIGIN and map CENTER on the map
  602.    LINE (320 - KP * dx, Ycen - KP * dy)-(960 - KP * dx, Ycen - KP * dy), 14
  603.    LINE (320 - KP * dx, Ycen - KP * dy)-(320 - KP * dx, 3 * Ycen - KP * dy), 14
  604.    CMX = 320 + Sfac * (CDX - LONcen) * Hfac'new
  605.    CMY = Ycen + Sfac * (CDY - LATcen) * Yfactr
  606.    LINE (CMX - 27, CMY)-(CMX + 27, CMY), 14
  607.    LINE (CMX, CMY - 20)-(CMX, CMY + 20), 14
  608.    CIRCLE (CMX, CMY), 10, 14
  609.    CIRCLE (320 - KP * dx, Ycen - KP * dy), 12, 14
  610.    s = 0: GOSUB MapPoint: REM Redraw MapPoint
  611.    StrtPt = -1
  612. DP: FOR i = s TO nmp - 1
  613.        x = 320 + KP * (x%(i) - dx) * Hfac
  614.        y = Ycen + KP * (y%(i) - dy) * Yfactr
  615.        X1 = 320 + KP * (x%(i + 1) - dx) * Hfac
  616.        Y1 = Ycen + KP * (y%(i + 1) - dy) * Yfactr
  617.        IF StrtPt = -1 THEN CIRCLE (x, y), 3, 9: StrtPt = 0
  618.        IF x%(i + 1) <> 0 THEN
  619.           IF RdsOn OR LineColor <> 12 THEN LINE (x, y)-(X1, Y1), LineColor
  620.           IF i = Z THEN SavClr = LineColor
  621.        ELSE
  622.           REM LINE (x - 3, y - 3)-(x + 3, y + 3), 10, B: StrtPt = -1
  623.           CIRCLE (x, y), 5, 10: StrtPt = -1
  624.           LineColor = y%(i + 1): i = i + 1
  625.           IF Display$ = "SHOW" AND LineColor > 8 THEN LineColor = LineColor - 8
  626.        END IF
  627.    NEXT i
  628.    GOSUB Cursor
  629.    GOSUB ReDraw
  630.    REM MapPoint went here
  631.    GOSUB DrawHist: REM draw GPS history track
  632.    IF Display$ = "SHOW" THEN
  633.       GOSUB ShowMaps
  634.    ELSE
  635.       LOCATE 25, 1: PRINT "Use +/- to move MAPpoint.  N/P for Next/Previous Feature.  H for HELP!.";
  636.       LOCATE 1, 61
  637.       PRINT "POINTS"; nmp; "= "; INT((nmp / MaxNumPoints) * 100); "%";
  638.       LOCATE 2, 61
  639.       PRINT "LABELS "; nml; "= "; INT((nml / MaxNumLABELS) * 100); "%";
  640.       LOCATE 3, 61: PRINT "CENTER  "; MID$(STR$(LATcen), 2, 5);
  641.       LOCATE 3, 75: PRINT MID$(STR$(LONcen), 2, 5)
  642.       LOCATE 4, 61: PRINT "SCALE   (ppd)"; ppdV
  643.       LOCATE 5, 69: PRINT "Range"; LEFT$(STR$(MapRng), 5)
  644.    END IF
  645.  
  646. labels:
  647.    IF Labls THEN
  648.       FOR i = 1 TO nml ' Now plot labels on map
  649.       IF RS <= MLr(i) OR Key$ = "S" THEN
  650.          LET x = 320 + Sfac * (CDX - MLo(i)) * Hfac'new
  651.          LET y = Ycen + Sfac * (CDY - MLa(i)) * Yfactr
  652.          IF Tags AND y > 14 * Yfactr AND y < 350 * Yfactr AND x > 8 * (LEN(ML$(i)) + 1) AND x < 632 THEN
  653.             LOCATE y / (14 * Yfactr), (x / 8) - LEN(ML$(i)): PRINT ML$(i);
  654.             END IF
  655.          END IF
  656.       NEXT i
  657.    END IF
  658.    GOSUB ShowMap: RETURN
  659.          
  660. ShowMap: REM this shows the map boarder of the loaded map
  661.     x = 320 + KP * (CDX - LONcen) * ppdV * Hfac'new
  662.     y = Ycen + KP * (CDY - LATcen) * ppdV * Yfactr
  663.       by = MapRng * Sfac * Yfactr / 60
  664.       bx = by * 640 / (400 * Yfactr) * Lfac'old
  665.       C = 15
  666.     LINE (x - bx, y - by)-(x + bx, y + by), C, B
  667.     RETURN
  668.  
  669. Cursor: CIRCLE (CUX, CUY), 4, 0
  670.      CUX = 320 + Sfac * (CDX - CPX) * Hfac'new
  671.      CUY = Ycen + Sfac * (CDY - CPY) * Yfactr
  672.      CIRCLE (CUX, CUY), 4, 14
  673.      x = INT(CPX): y = INT(CPY): Xm = (CPX - x) * 60: Ym = (CPY - y) * 60
  674.      x$ = RIGHT$(STR$(x), 3) + " "
  675.      LOCATE 1, 2: PRINT "RNG"; RIGHT$("   " + STR$(RS), 4) + "      "
  676.      LOCATE 2, 2: PRINT "LAT "; y; MID$(STR$(Ym) + "   ", 2, 5)
  677.      LOCATE 3, 2: PRINT "LON "; x$; MID$(STR$(Xm) + "   ", 2, 5)
  678.     
  679.      LOCATE 24, 1: PRINT "Cursor coordnts:"; TAB(17);
  680.      PRINT INT(.5 + dx + (CUX - 320) / KP); TAB(23); INT(.5 + dy + (CUY - Ycen) / KP);
  681.      REM LOCATE 24, 55: PRINT "Degrees: ";
  682.      REM PRINT LEFT$(STR$(CPY) + " ", 7); LEFT$(STR$(CPX) + "   ", 7);
  683.      LOCATE 1, 16: PRINT "Decimal";
  684.      LOCATE 2, 15: PRINT LEFT$(STR$(CPY) + " ", 8);
  685.      LOCATE 3, 15: PRINT LEFT$(STR$(CPX) + "   ", 8);
  686.      LINE (0, 0)-(178, 42 * Yfactr), 12, B'Box around it
  687.      LINE (0, 0)-(116, 42 * Yfactr), 12, B'Box around it
  688.      LET a$ = "": LET B$ = "": RETURN
  689.  
  690. HELP: CLS : COLOR 15, 1: LINE (0, 0)-(639, 18 * Yfactr), 14, BF
  691.       LOCATE 1, 20: PRINT " MAPFIX.bas HELP SCREEN Ver "; Ver$
  692.       LOCATE 3, 1
  693.       
  694.       PRINT " The cursor is shown in LAT/LON, map offset and decimal degrees.   The ORIGIN,"
  695.       PRINT " CENTER and BORDER are shown (but only the CENTER and RANGE in MAPLIST.map are"
  696.       PRINT " actually used by APRS.  Labels are right justified to the point just after the"
  697.       PRINT " last letter.  CALLS & OBJECT names will be left justified."
  698.       PRINT ""
  699.       PRINT " OPERATIONS          MAP FUNCTIONS         @N - NEW FEATURE   LABEL COMMANDS"
  700.       PRINT " H - HELP SCREENS    @C- Change CENTER     @A - ADD point      S - SHOW labels"
  701.       PRINT " D - map DIRECTORY   ^C- Change COLOR      @D - DELETE point  @L - add a LABEL"
  702.       PRINT "^S - SAVE MAP!!!     M - MAPLIST.apr file  @K - Kill feature   L - LABELS off"
  703.       PRINT " R - RESET pointers  O - OTHER map bordrs  @M - MOVE point"
  704.       PRINT " Q - QUIT            @R- set map RANGE     @T - TRIM borders"
  705.       PRINT "                                               "
  706.       PRINT " MAP COMMANDS        POINTER MOVEMENTS   USGS CD ROM CMDS   DIGITIZER & GPS "
  707.       PRINT " SPACE to draw map   N - Next Feature    B - BOX PPD area   @O- OPEN COMMS"
  708.       PRINT " ARROWS  (shft)      P - Prev Feature    U - USGS overlay   @B- BEGIN new line"
  709.       PRINT " PgUP/DN (ctrl)      G - Go to Pointer   T - Test smoother "
  710.       PRINT " HOME to Cursor      F - Find point      @S- SMOOTH file"
  711.       PRINT " END to map center   ^F- Find another    @U- USGS BUILD!    @G- GPS OVERLAY"
  712.       PRINT "                     +/- move Pointer    @J- JOIN lines"
  713.       PRINT "                                         ^R- REDRAW on/off"
  714.       PRINT : LINE (0, 190 * Yfactr)-(639, 190 * Yfactr), 15
  715.               
  716.       IF Display$ <> "HELP" THEN
  717.        LOCATE 25, 1
  718.        PRINT " HIT H AGAIN FOR MORE HELP SCREENS, OR SPACE BAR FOR MAP...";
  719.       END IF
  720.       Display$ = "HELP"
  721.       LINE (0, 0)-(634, 348 * Yfactr), 15, B
  722.       RETURN
  723.  
  724.  
  725.  
  726. REM ************* HERE IS THE CODE BROUGHT IN FROM APRS  ***************
  727.  
  728. LdMapLst: GOSUB BoxLine23: INPUT "FileSpec for MAPLIST.apr if not \APRS\MAPLIST.APR"; a$
  729.           IF a$ <> "" THEN F$ = a$ ELSE F$ = "\aprs\Maplist.apr"
  730.           OPEN F$ FOR INPUT AS #3: IF Fault <> 0 THEN RETURN
  731.           i = 1: NumGood = 0
  732.           INPUT #3, DfltY: LINE INPUT #3, a$
  733.           INPUT #3, DfltX: LINE INPUT #3, a$
  734.           INPUT #3, BestRng: LINE INPUT #3, a$: DfltR = BestRng
  735.           INPUT #3, GMToffset: LINE INPUT #3, a$
  736.     WHILE a$ <> "* BEGIN *": LINE INPUT #3, a$: WEND ' Skip comment block
  737.           REM RS = BestRng: REM center display
  738.           REM RS = 2 ^ INT(LOG(RS) / LOG(2))'Rng is intgr power of 2
  739.           REM CPX = CDX: CPY = CDY 'Cursor Posn to Center of Display
  740.     WHILE NOT EOF(3) AND i <= UBOUND(MapName$)
  741.           INPUT #3, MapName$(i), LATcen(i), LONcen(i), MapMax(i)
  742.           LINE INPUT #3, Comment$(i)' IGNORE ALL comment fields
  743.           REM now ignore maps that start with a *
  744.           IF LEFT$(MapName$(i), 1) <> "*" THEN NumGood = NumGood + 1
  745.           NumMaps = i: i = i + 1
  746.     WEND: CLOSE #3
  747.     IF NumGood >= MaxNumMAPS - 1 THEN
  748.           CLS : LOCATE 2, 5
  749.           PRINT "WARNING: Too many ACTIVE MAPS (more than"; MaxNumMAPS; ") in MAPLIST.map file for APRS"
  750.           LOCATE 4, 10: PRINT "Use EDITOR to suppress mapnames with an (*) that you don't need."
  751.           PRINT : PRINT : PRINT : MapListLoaded = -1
  752.           INPUT "HIT RETURN to continue"; a$
  753.     END IF
  754.     RETURN
  755.  
  756. ListMAPlist: IF NOT MapListLoaded THEN GOSUB LdMapLst
  757.    GOSUB ListHeader
  758.    FOR i = 1 TO NumMaps
  759.        IF i / 19 = INT(i / 19) THEN
  760.           LOCATE 25, 1: PRINT "HIT RETURN to continue"; : INPUT a$
  761.           GOSUB ListHeader
  762.        END IF
  763.        PRINT MapName$(i); TAB(14);
  764.        PRINT INT(LATcen(i) * 100) / 100; TAB(21); INT(LONcen(i) * 100) / 100;
  765.        PRINT TAB(29); MapMax(i); TAB(36); LEFT$(LTRIM$(Comment$(i)), 43)
  766.    NEXT i
  767.    
  768.    LOCATE 25, 1: PRINT "LIST COMPLETE. CONTINUE WITH NEXT MAPFIX COMMAND...";
  769.    RETURN
  770.  
  771. ListHeader: CLS
  772.    PRINT "MAPS in MAPLIST.map (*MAPS are suppressed)     [For now, use EDITOR to modify]"
  773.    PRINT :
  774.    PRINT "MAP NAME      LATcen LONcen  RANGE COmments"
  775.    PRINT "------------  ------ ------- ----- -------------------------------------------"
  776.    RETURN
  777.  
  778. DrwAndShow: IF NOT MapListLoaded THEN GOSUB LdMapLst
  779.             Display$ = "SHOW": GOSUB DrwMPaCur
  780.  
  781. ShowMaps: IF MapSize > RS / 2 THEN MapSize = RS / 2
  782.     LOCATE 25, 1: PRINT " Drawing all maps >"; MapSize;
  783.     PRINT "mi.  F3 to see smaller, F4 for bigger, SPACE to cancel.";
  784.     LINE (0, 336 * Yfactr)-(639, 349 * Yfactr), 14, B
  785.     FOR i = 1 TO NumMaps
  786.    
  787.     x = 320 + Sfac * (CDX - LONcen(i)) * Hfac
  788.     y = Ycen + Sfac * (CDY - LATcen(i)) * Yfactr
  789.       dy = MapMax(i) * Sfac * Yfactr / 60
  790.       dx = dy * 640 / (400 * Yfactr) * Lfac
  791.       C = 15
  792.       IF MapMax(i) > 32 THEN C = 14
  793.       IF MapMax(i) > 64 THEN C = 12
  794.       IF MapMax(i) > 128 THEN C = 11
  795.       IF MapMax(i) > 256 THEN C = 13
  796.           
  797.     IF MapMax(i) > MapSize THEN
  798.        LINE (x - dx, y - dy)-(x + dx, y + dy), C, B
  799.        IF y + dy > 14 * Yfactr AND y + dy < 350 * Yfactr THEN
  800.           IF x + dx > 8 * (LEN(MapName$(i)) + 1) AND x + dx < 632 THEN
  801.              LOCATE (y + dy) / (14 * Yfactr), (x + dx) / 8 - LEN(MapName$(i))
  802.              IF MapMax(i) > RS / 4 THEN PRINT MapName$(i);
  803.           END IF
  804.        END IF
  805.     END IF
  806.     NEXT i: RETURN
  807.         
  808. REM ******* here is the code added by W7KKE for overlyaying track histoiries
  809. 'This module retrieves GPS history files so you can check the accuracy of
  810. 'the map
  811.  
  812. Hstdir: CLS : PRINT "HISTORY FILES DIRECTORY": PRINT
  813.          PRINT "To display HST files, please enter the path to your xxxxxxx.HST files."
  814.          PRINT "For example, the default '\APRS\*.HST' will show all maps in the APRS"
  815.          PRINT "directory.  Similarly '*.hst' will search your present QBasic directory."
  816.          PRINT "For any other path, enter the full file specification.": PRINT
  817.          
  818.          PRINT "Enter Filespec for searching the DIRECTORY (\aprs\*.hst)";
  819.          INPUT F$: IF F$ = "" THEN F$ = "\aprs\*.hst"
  820.          IF INSTR(F$, ".") = 0 THEN F$ = F$ + ".HST"
  821.          PRINT : PRINT : FILES F$
  822.          RETURN
  823.  
  824. LoadHst: GOSUB BoxLine23
  825.        INPUT "Which history file to load (ENTER for list, Q to quit)"; F$
  826.        IF UCASE$(F$) = "Q" THEN RETURN
  827.        IF F$ = "" THEN GOSUB Hstdir: GOTO LoadHst
  828.        a = INSTR(3, F$, "."): IF a = 0 THEN F$ = F$ + ".hst"
  829.        Fault = 0: F$ = UCASE$(F$): OPEN F$ FOR INPUT AS #3
  830.    
  831.        IF Fault = 53 OR Fault = 62 THEN Fault = 0: RETURN
  832.        GOSUB BoxLine23: PRINT "Loading track history from "; F$
  833.        
  834.     DO WHILE NOT EOF(3)
  835.        i = i + 1
  836.        INPUT #3, a$
  837.        HLAT(i) = VAL(MID$(a$, 26, 2)) + (VAL(MID$(a$, 28, 5)) / 60)
  838.        HLONG(i) = VAL(MID$(a$, 35, 3)) + (VAL(MID$(a$, 38, 5)) / 60)
  839.        maxhist = i
  840.      LOOP
  841.      CLOSE #3: Histloaded = -1
  842.      GOSUB BoxLine23: PRINT "File loading is complete.  GPS data is plotted."
  843.      REM fall through...
  844.  
  845. DrawHist:  'put history track on map
  846.      IF Histloaded THEN
  847.         size = 3: IF RS < 2 THEN size = size * 2 / RS
  848.         FOR i = 1 TO maxhist
  849.             HMX = 320 + KP * (CDX - HLONG(i)) * ppdV * Hfac'new
  850.             HMY = Ycen + KP * (CDY - HLAT(i)) * ppdV * Yfactr
  851.             CIRCLE (HMX, HMY), size, 13
  852.         NEXT i
  853.      END IF
  854.      RETURN
  855.  
  856. NewMap: CLS : PRINT "BEGINNING A NEW MAP FROM SCRATCH...": PRINT
  857.    PRINT "All points in an APRS map are measured as an"
  858.    PRINT "offset to the right and down from an origin."
  859.    PRINT
  860.    INPUT "Enter the LATITUDE  of the ORIGIN in decimal degrees"; LATo
  861.    INPUT "Enter the LONGITUDE of the ORIGIN in decimal degrees"; LONo
  862.    PRINT
  863.    PRINT "Choose the number of pixels per degree to set the map scale:"
  864.    PRINT
  865.    PRINT "Approximate size    Range from center  Pixels/Deg"
  866.    PRINT "----------------    -----------------  ----------"
  867.    PRINT "Big state or region        250             120"
  868.    PRINT "Typical state              100             300"
  869.    PRINT "Several Counties            50             600"
  870.    PRINT "Typical VHF range           25            1200"
  871.    PRINT "City streets (7.5 min maps) 12            2400"
  872.    PRINT
  873.    INPUT "Enter desired Pixels/Deg"; ppdB
  874.    IF ppdB = 0 THEN GOTO NewMap
  875.    REM In following lines, 500 is half of 999 (maximum nominal value for pts)
  876.    LATcen = LATo - (500 * Yfactr / ppdB)
  877.    LONcen = LONo - (500 / ppdB)
  878.    GOSUB StartMap: ppdV = ppdB
  879.    CLS : PRINT "YOU ARE NOW READY TO DRAW A NEW MAP...": PRINT : PRINT
  880.    PRINT "A white border has been drawn around the maximum size permitted for this map"
  881.    PRINT
  882.    PRINT "USING CURSOR WITHOUT DIGITIZER:  Move coursor to starting point for a NEW"
  883.    PRINT "feature and hit ALT-N.  Then enter new feature name (for reference purposes)"
  884.    PRINT "and continue moving cursor to the next point and hit ALT-A to add more points."
  885.    PRINT "Continue in this fashion, using ALT-N whenever you want to begin a NEW feature."
  886.    PRINT
  887.    PRINT "USING A DIGITIZER:  First, use ALT-O once to OPEN the digitizer COM port.  Then"
  888.    PRINT "use ALT-B to BEGIN each new map feature.  Enter the name and color of the new"
  889.    PRINT "feature.  Then use the digitizer mouse to add more points."
  890.    PRINT : PRINT : PRINT
  891.    PRINT "Add LABELS on the map at the current cursor location by using the ALT-L key. "
  892.    PRINT
  893.    PRINT "When you are finished, be sure to SAVE the map using the CTRL-S command..."
  894.    PRINT : PRINT : PRINT
  895.    PRINT "FOR HELP, REMEMBER THE  H  KEY!"
  896.    PRINT : PRINT : PRINT "Hit ENTER to proceed..."; : INPUT a$
  897.    RETURN
  898.  
  899. StartMap: REM This called by NEW and in middle of USGS build
  900.    LATcen$ = "LAT of CENTER": LONcen$ = "LON of CENTER"
  901.    MapRng = 60 * 500 * Yfactr / ppdB: REM 500 is half of full map size
  902.    MapRng$ = "Map range from center"
  903.    VS$ = "Pixels per degree"
  904.    MinRng = 1: MR$ = "No longer used"
  905.    TextLine$ = "NEW Map generated by MAPFIX.bas routine..."
  906.    IF Key$ = "NEW" THEN RS = 2 ^ INT(LOG(MapRng) / LOG(2))'Rng is intgr of VERTrng
  907.    CDX = LONcen: CDY = LATcen: CPX = CDX: CPY = CDY
  908.    nmp = 1: nml = 0
  909.    LNi = 1: LN$(1) = "Labels begin here"
  910.    RETURN
  911.  
  912.  
  913. DigiInit: CLS : PRINT : Digitizer = -1
  914.    PRINT "This routine will replace many CURSOR functions with the Digitizer's MOUSE."
  915.    PRINT "Assuming your digitizer can output an X,Y,C format."
  916.    PRINT
  917.    PRINT "Only Mercator projection charts will give absolutely accurate results.  Other"
  918.    PRINT "types, Lambert Conformal, Conical, etc will induce distortions."
  919.    PRINT
  920.    PRINT "It has not been tested with East Longitude or South Latitude."
  921.    PRINT : PRINT
  922.    PRINT "The digitizr should operate at 9600,N,8,1 in POINT mode with 200 LPI resolution."
  923.    PRINT "The FORMAT outputs X,Y,C values separated by commas (C is for button pressed."
  924.    PRINT
  925.    PRINT "Set up the digitizer according to your model's instructions.  For the model"
  926.    PRINT "23360, use the drawing board menu by pressing the mouse button 0 on the SETUP"
  927.    PRINT "label so that the LED is ON.  Then move the mouse to each other label and"
  928.    PRINT "use the 0 button to toggle the value ON or off as follows:"
  929.    PRINT
  930.    PRINT "POINT is ON                             PARITY 7/8 and 1 are ON "
  931.    PRINT "BAUDRATE 3 is ON                        FORMAT is ON ON off ON"
  932.    PRINT "DATA RATE doesn't matter                RESOLUTION off off ON"
  933.    PRINT : PRINT
  934.    INPUT "Is DIGITIZER connected to COM1 or COM2 (1)"; a$
  935.    IF a$ <> "2" THEN a$ = "COM1" ELSE a$ = "COM2"
  936.  
  937.    Port$ = a$ + ":9600,N,8,1,cs0,ds0,cd0"
  938.    OPEN Port$ FOR RANDOM AS #1
  939.    
  940.  
  941.    CLS : PRINT "FIRST LETS TEST THE DIGITIZER, AND GET THE MAP ON STRAIGHT.": PRINT
  942.    PRINT "Move your mouse (or pen) and hit the 0 button (or touch tablet) to see if the"
  943.    PRINT "digitizer is outputting in the desired format.  While doing this, it is a good"
  944.    PRINT "idea to verify that your map is on straight.  The Y values from the mouse"
  945.    PRINT "should give the same values for the same LATITUDE line on both the right and"
  946.    PRINT "left edges of the map.  If not, move your map to get it horizontal."
  947.    PRINT
  948.    PRINT "OUTPUT FORMAT:"
  949.    PRINT
  950.    PRINT "XXXXX,YYYYY,APn (Only the X and Y values are used (4 or 5 digits is ok)"
  951.    PRINT
  952.    LOCATE 25, 1: PRINT "Hit ENTER and press 0 button on mouse to continue...";
  953.    LOCATE 13, 1
  954.    DO UNTIL INKEY$ <> "": LINE INPUT #1, a$: PRINT a$: LOOP
  955.   
  956.    CLS : PRINT
  957.    PRINT "NEXT YOU MUST ESTABLISH THE SCALE OF YOUR DIGITIZER."
  958.    PRINT
  959.    PRINT "The scale is established by two points, the first near the"
  960.    PRINT "upper left corner, the second near the lower right corner."
  961.    PRINT
  962.    PRINT "To get the best accuracy on maps not exactly MERCATOR, use points within the "
  963.    PRINT "area where you are working, not on the extreme corners.  IE:  choose points"
  964.    PRINT "that are in the center of the upper left quadrant and the lower right quadrant."
  965.    PRINT
  966.    PRINT "To establish the upper left reference point:"
  967.    INPUT "     Enter lat  (deg,min)"; LATref1, M: LATref1 = LATref1 + M / 60
  968.    INPUT "     Enter long (deg,min)"; LONref1, M: LONref1 = LONref1 + M / 60
  969.    PRINT
  970.  
  971.    PRINT "Place the mouse on the upper left point and press the 0 button."
  972.    LINE INPUT #1, a$: SOUND 150, 3
  973.         digix1 = 5000 - VAL(LEFT$(a$, 5))
  974.         digiy1 = VAL(MID$(a$, 7, 5))
  975.         PRINT "Digitizer reads "; digix1, digiy1; " for this point.": PRINT
  976.  
  977.    PRINT "NOW Establish the lower right reference point:"
  978.    INPUT "      Enter lat  (deg,min)"; LATref2, M: LATref2 = LATref2 + M / 60
  979.    INPUT "      Enter long (deg,min)"; LONref2, M: LONref2 = LONref2 + M / 60
  980.    PRINT
  981.    PRINT "Place digitizer pen on lower right point."
  982.    LINE INPUT #1, a$: SOUND 150, 3
  983.         digix2 = 5000 - VAL(LEFT$(a$, 5))
  984.         digiy2 = VAL(MID$(a$, 7, 5))
  985.         PRINT "Digitizer reads "; digix2, digiy2; " for this point.": PRINT
  986.  
  987.    REM Find delta lat/long between reference points
  988.    REM Calculate degrees per x/y unit
  989.         degx# = (LONref1 - LONref2) / (digix1 - digix2)
  990.         degy# = (LATref1 - LATref2) / (digiy1 - digiy2)
  991.  
  992.    CLS : PRINT "YOU ARE NOW READY TO USE THE DIGITIZER TO ENTER POINTS INTO MAPFIX..."
  993.    PRINT
  994.    PRINT "The digitizer works just about like the cursor and arrow keys in MAPFIX.  Any"
  995.    PRINT "point identified by the digitizer will be ADDED just as if you had hit ALT-A."
  996.    PRINT "All points are added to a feature after the current MapPoint identified by the"
  997.    PRINT "white circle. "
  998.    PRINT
  999.    PRINT "With the digitizer, do NOT use the ALT-N NEW command which always begins at the"
  1000.    PRINT "current cursor location.  For the digitizer, use ALT-B to BEGIN a new feature."
  1001.    PRINT "You will be asked to identify the name and color of the new feature.  From then"
  1002.    PRINT "on, just move the digitizer mouse (or pen) to ADD new points.  "
  1003.    PRINT
  1004.    PRINT "If your digitizer mouse has 4 buttons, use the first (left) button for ADDing "
  1005.    PRINT "points, use the 4th (right) button to just move the cursor with no action."
  1006.    PRINT : PRINT
  1007.    INPUT "Hit ENTER to continue with MAPFIX..."; a$
  1008.    RETURN
  1009.  
  1010. GetXY: LINE INPUT #1, a$: SOUND 150, 3
  1011.        a = INSTR(a$, ","): IF a = 0 THEN RETURN
  1012.            x = 5000 - VAL(LEFT$(a$, a - 1))
  1013.        B = INSTR(a + 1, a$, ","): IF B = 0 THEN B = LEN(a$)
  1014.        y = VAL(MID$(a$, a + 1, B - (a)))
  1015.        Btn = VAL(RIGHT$(a$, 1))
  1016.        CPY = ((y - digiy2) * degy#) + LATref2
  1017.        CPX = ((x - digix2) * degx#) + LONref2
  1018.        IF LOC(1) <> 0 THEN a$ = INPUT$(LOC(1), #1)'Clear input buffer
  1019.        RETURN
  1020.  
  1021. BoxPPD: GOSUB BoxLine23: INPUT "Enter the desired PPD"; a$: ppdB = VAL(a$)
  1022.    dy = (30000 / ppdB) * Sfac * Yfactr / 60
  1023.    dx = dy * 640 / (400 * Yfactr) * Lfac
  1024.    GOSUB BoxLine23: LINE (CUX - dx, CUY - dy)-(CUX + dx, CUY + dy), 13, B
  1025.    PRINT "The box represents the largest APRS map that can be made with that scale."
  1026.    RETURN
  1027.         
  1028.  
  1029. GetUSGS: REM This used for both U=OVERLAY and by ALT-U = USGS BUILD!
  1030.    ReDraw = 0: USGS = -1: ni = 0: nt = 0: j = 0: NumLines = 0: LE = 1: OE = 1
  1031.    IF Key$ <> "U" THEN
  1032.       IF ppdB <> 0 THEN ppdV = ppdB
  1033.       LATo = CDY + (500 * Yfactr / ppdV)
  1034.       LONo = CDX + (500 / ppdV)
  1035.       GOSUB BoxLine23: PRINT "Improve LAT ORIGIN of "; LATo; : INPUT LATo
  1036.       GOSUB BoxLine23: PRINT "Improve LON ORIGIN of "; LONo; : INPUT LONo
  1037.       GOSUB BoxLine23: INPUT "LATitude extent (100%)"; a$
  1038.             IF a$ <> "" THEN LE = VAL(a$) / 100
  1039.       GOSUB BoxLine23: INPUT "LONgitude extent (100%)"; a$
  1040.             IF a$ <> "" THEN OE = VAL(a$) / 100
  1041.       dx = ppdV * (LONo - CDX)
  1042.       dy = ppdV * (LATo - CDY)
  1043.       KP = 100 * 100 / (RS * ppdV)
  1044.       LATcen = CDY: LONcen = CDX: GOSUB StartMap
  1045.       LATtext$ = "Decimal LATITUDE  of map ORIGIN"
  1046.       LONtext$ = "Decimal LONGITUDE of map ORIGIN"
  1047.       TextLine$ = "Map generated by MAPFIX from USGS 2,000,000:1 CD ROM (data valid mid-1980's)"
  1048.    END IF
  1049.    Lmax = 500 + 600 * LE: Lmin = 500 - 600 * LE 'Max=1100 and Min =-100
  1050.    Omax = 500 + 600 * OE: Omin = 500 - 600 * OE
  1051.    GOSUB BoxLine23: INPUT "Enter path and filename of XTRACTED USGS data file"; a$
  1052.    a = INSTR(a$, "."): IF a = 0 THEN a$ = a$ + ".GRF"
  1053.    OPEN a$ FOR INPUT AS #3
  1054.    IF Fault <> 0 THEN RETURN
  1055.    GOSUB BoxLine23: INPUT "Enter RANK cutoff. (all roads = 99) for ST and WB use 20, or 10"; a$
  1056.    MaxRnk = VAL(a$)
  1057.    REM PRINT "raw data format.....", "   LineID", "#-Rnk-Atbts", "  NumPts"
  1058.    LOCATE 5, 67: PRINT "RANGE: "; INT(30000 / ppdV): LOCATE 24, 1
  1059.    IF Key$ = "U" THEN
  1060.       PRINT "While USGS OVERLAYED, do not redraw map or you will have to do it again...";
  1061.    ELSE PRINT "Blue circles start lines, Green Box ends.  Red points discarded, Yellow Kept!";
  1062.    END IF
  1063.  DO UNTIL EOF(3) OR LNi = MaxNumLines - 1
  1064.    NumLines = NumLines + 1
  1065.    LOCATE 1, 61: PRINT "TOTAL POINTS: "; nt
  1066.    LOCATE 2, 61: PRINT "POINTS USED:  "; ni
  1067.    LOCATE 3, 61: PRINT "TOTAL LINEs:  "; NumLines
  1068.    LOCATE 4, 61: PRINT "LINEs USED:   "; LNi
  1069.    a$ = INPUT$(20, 3): REM PRINT a$;
  1070.         LnID$ = LEFT$(a$, 7)
  1071.         Rank$ = MID$(a$, 8, 2): Rank = VAL(Rank$): LOCATE 6, 67: PRINT "RANK: "; Rank
  1072.         Npts$ = MID$(a$, 10, 6): Npts = VAL(Npts$)
  1073.         AtCd$ = MID$(a$, 16, 5)
  1074.         a$ = LTRIM$(LnID$) + "-" + Rank$ + "-" + AtCd$
  1075.         REM PRINT , LnID$, a$, Npts$
  1076.    IF Rank < 24 THEN SavClr = 4 ELSE SavClr = 7
  1077.    IF Rank < 20 THEN SavClr = 12
  1078.    IF Rank < 14 THEN SavClr = 10
  1079.    LineOK = 0: IF Key$ <> "U" THEN GOSUB BeginF
  1080.    FOR i = 1 TO Npts
  1081.     a$ = INPUT$(20, 3): IF Rank > MaxRnk THEN GOTO Skp
  1082.     REM IF VAL(Rank$) > 99 THEN GOTO Skp
  1083.     LA = VAL(LEFT$(a$, 2)) + VAL(MID$(a$, 3, 2)) / 60 + VAL(MID$(a$, 5, 2)) / 3600
  1084.     LO = VAL(MID$(a$, 8, 3)) + VAL(MID$(a$, 11, 2)) / 60 + VAL(MID$(a$, 13, 2)) / 3600
  1085.     IF Key$ = "U" THEN
  1086.         REM Following lines used to limit points if just doing an OVERLAY only
  1087.         IF LA > CDY + RS / 60 OR LA < CDY - RS / 50 THEN GOTO Skp 'off screen
  1088.         IF LO > CDX + RS / 40 OR LO < CDX - RS / 40 THEN GOTO Skp
  1089.         REM s$ = MID$(a$, 16, 5)
  1090.         REM PRINT S$, LA, LO
  1091.         END IF
  1092.     y% = (LATo - LA) * ppdV: x% = (LONo - LO) * ppdV
  1093.     IF Key$ <> "U" AND (x% > Omax OR x% < Omin) THEN GOTO Skp'this ignores points off PPD
  1094.     IF Key$ <> "U" AND (y% > Lmax OR y% < Lmin) THEN GOTO Skp'scale
  1095.     LineOK = -1
  1096.        X1 = 320 + KP * (x% - dx) * Hfac
  1097.        Y1 = Ycen + KP * (y% - dy) * Yfactr
  1098.        IF i > 2 THEN
  1099.           REM LINE (x, y)-(X1, Y1), 6
  1100.           dd = LO - LOb: IF dd = 0 THEN dd = .0000001
  1101.           dn = LA - LAb
  1102.           s = dn / dd' Note that 1>s>.01 for Xdelta of 1 to 100
  1103.           IF ABS(s) < .1 AND ABS(Lsp) < .1 THEN
  1104.              sd = 1
  1105.           ELSEIF ABS(s) > 10 AND ABS(Lsp) > 10 THEN sd = 1
  1106.           ELSEIF ABS(dd) < .004 AND ABS(dn) < .004 THEN sd = 1
  1107.           ELSEIF s <> 0 THEN sd = Lsp / s
  1108.           ELSE sd = 0
  1109.           END IF
  1110.           IF sd > 2 OR sd < .5 OR i = Npts THEN
  1111.              CIRCLE (x, y), 1, 14
  1112.              IF Key$ <> "U" THEN GOSUB KeepLine
  1113.           ELSE CIRCLE (x, y), 1, 4
  1114.           END IF
  1115.           Lsp = s: nt = nt + 1
  1116.        ELSE Lsp = 0: CIRCLE (X1, Y1), 4, 9
  1117.           IF Key$ <> "U" THEN GOSUB KeepLine 'keeps first two lines
  1118.        END IF
  1119.        LAb = LA: LOb = LO
  1120.        x = X1: y = Y1
  1121.        
  1122. Skp: NEXT i
  1123.      IF Key$ <> "U" THEN
  1124.         IF LineOK THEN nmp = nmp - 1: Z = Z - 1: ni = ni + 1 ELSE GOSUB CanclF
  1125.      END IF
  1126.      LINE (x - 3, y - 3)-(x + 3, y + 3), 10, B ' Last Point
  1127.  LOOP
  1128.  IF LNi > MaxNumLines - 2 THEN LOCATE 12, 20: PRINT "PROCESSING STOPPED... TOO MANY LLINES!..."
  1129.    CLOSE #3
  1130.    RETURN
  1131.  
  1132. KeepLine: x%(Z) = x%: y%(Z) = y%: nmp = nmp + 1: Z = Z + 1: ni = ni + 1: RETURN
  1133.  
  1134.  
  1135. Scrunch: i = 0: Pt = 0: nt = 0: ni = 0: GOSUB BoxLine23
  1136.     INPUT "Enter slope filter ratio 1.2 to 5 (typically 1.5)"; a$
  1137.     IF a$ = "" THEN slope = 1.5 ELSE slope = VAL(a$)
  1138.     DO UNTIL i >= nmp - 1
  1139.        i = i + 1
  1140.        X1 = 320 + KP * (x%(i) - dx) * Hfac
  1141.        Y1 = Ycen + KP * (y%(i) - dy) * Yfactr
  1142.        IF x%(i) <> 0 THEN
  1143.           Pt = Pt + 1
  1144.           IF Pt > 2 THEN
  1145.              LINE (x, y)-(X1, Y1), 6
  1146.              dd = x - X1
  1147.              dn = y - Y1
  1148.              IF dd = 0 AND dn = 0 THEN
  1149.                 sd = slope: s = Lsp  'Here the points are identical
  1150.                 CIRCLE (x, y), 9, 13
  1151.              ELSE
  1152.                 IF dd = 0 THEN dd = .01
  1153.                 dst = ((dd * dd) + (dn * dn)) ^ .5
  1154.                 s = dn / dd' Note that 1>s>.01 for Xdelta of 1 to 100
  1155.                 IF s = 0 THEN s = .05
  1156.                 IF ABS(s) < .2 THEN s = .2 * SGN(s)
  1157.                 IF ABS(s) > 5 THEN s = 5 * SGN(s)
  1158.                 IF ABS(s) <= .2 AND ABS(Lsp) <= .2 THEN
  1159.                    sd = 1
  1160.                 ELSEIF ABS(s) >= 5 AND ABS(Lsp) >= 5 THEN sd = 1
  1161.                 ELSE sd = Lsp / s
  1162.                 END IF
  1163.                 IF ABS(dd) > 50 * KP OR ABS(dn) > 30 * KP THEN sd = 0
  1164.                 REM IF ABS(dd) < 5 OR ABS(dn) < 4 THEN sd = 1
  1165.              END IF
  1166.              IF sd > slope OR sd < 1 / slope OR x%(i + 1) = 0 OR NumRej > 4 THEN
  1167.                 ni = ni + 1: CIRCLE (x, y), 2, 14: NumRej = 0
  1168.                 
  1169.              ELSE CIRCLE (x, y), 1, 4: NumRej = NumRej + 1
  1170.                 IF Key$ <> "T" THEN
  1171.                    i = i - 1: nmp = nmp - 1
  1172.                    FOR ii = i TO nmp
  1173.                        x%(ii) = x%(ii + 1): y%(ii) = y%(ii + 1)
  1174.                    NEXT ii
  1175.                 END IF
  1176.              END IF
  1177.              Lsp = s: nt = nt + 1
  1178.           ELSE Lsp = 0: nt = nt + 1: ni = ni + 1: CIRCLE (X1, Y1), 4, 9
  1179.           END IF
  1180.        ELSE Pt = 0: nt = nt + 1: ni = ni + 1
  1181.           LOCATE 1, 61: PRINT "TOTAL POINTS: "; nt
  1182.           LOCATE 2, 61: PRINT "SAVED POINTS: "; ni
  1183.        END IF
  1184.        x = X1: y = Y1
  1185.     LOOP
  1186.     RETURN
  1187.  
  1188. Join: REM Search for end=begin point values and CONCATONATE if equal!
  1189.    LnPtr = 0: i = 0: k = 0: GOSUB BoxLine23: PRINT "Lines joined: ";
  1190.    DO UNTIL i >= nmp
  1191.       i = i + 1
  1192.        IF x%(i) = x%(i + 2) AND y%(i) = y%(i + 2) AND y%(i + 1) = LColor THEN
  1193.           nmp = nmp - 2: LNi = LNi - 1: k = k + 1: LOCATE 23, 15: PRINT k
  1194.           FOR j = i + 1 TO nmp: x%(j) = x%(j + 2): y%(j) = y%(j + 2): NEXT j
  1195.           FOR j = LnPtr TO LNi: LN$(j) = LN$(j + 1): NEXT j
  1196.        ELSEIF x%(i) = 0 THEN LColor = y%(i): LnPtr = LnPtr + 1
  1197.        END IF
  1198.    LOOP: GOTO DrawMap
  1199.  
  1200. END
  1201.  
  1202.